home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue53 / Clinic / CopyAFile2Form.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-12-03  |  1.7 KB  |  76 lines
  1. unit CopyAFile2Form;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     btnCopy: TButton;
  12.     dlgSource: TOpenDialog;
  13.     procedure btnCopyClick(Sender: TObject);
  14.   private
  15.     { Private declarations }
  16.   public
  17.     { Public declarations }
  18.   end;
  19.  
  20. var
  21.   Form1: TForm1;
  22.  
  23. implementation
  24.  
  25. {$R *.DFM}
  26.  
  27. uses
  28.   ShellAPI, ShlObj;
  29.  
  30. procedure FileCopy(const Source, Target: String);
  31. var
  32.   FOS: TSHFileOpStruct;
  33.   SourceLst: String;
  34. begin
  35.   FillChar(FOS, SizeOf(FOS), 0);
  36.   FOS.Wnd := Application.MainForm.Handle;
  37.   FOS.wFunc := FO_COPY;
  38.   //File name list must have 2 null terminators. It
  39.   //gets 1 anyway. The other we pass in explicitly
  40.   SourceLst := Source + #0;
  41.   FOS.pFrom := PChar(SourceLst);
  42.   FOS.pTo := PChar(Target);
  43.   //Uncomment these 2 lines if you do not want the file
  44.   //name details shown on the copy progress dialog
  45.   //FOS.fFlags := FOF_SIMPLEPROGRESS;
  46.   //FOS.lpszProgressTitle := 'Please wait...'
  47.   SHFileOperation(FOS);
  48. end;
  49.  
  50. function GetFolder: String;
  51. var
  52.   BrowseInfo: TBrowseInfo;
  53.   Folder: array[0..MAX_PATH] of Char;
  54. begin
  55.   FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  56.   BrowseInfo.hwndOwner := Application.MainForm.Handle;
  57.   BrowseInfo.lpszTitle := 'Select destination folder';
  58.   BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS or BIF_DONTGOBELOWDOMAIN;
  59.   SHGetPathFromIDList(SHBrowseForFolder(BrowseInfo), Folder);
  60.   Result := Folder;
  61. end;
  62.  
  63. procedure TForm1.btnCopyClick(Sender: TObject);
  64. var
  65.   TargetFolder: String;
  66. begin
  67.   if dlgSource.Execute then
  68.   begin
  69.     TargetFolder := GetFolder;
  70.     if TargetFolder <> '' then
  71.       FileCopy(dlgSource.FileName, TargetFolder)
  72.   end
  73. end;
  74.  
  75. end.
  76.